A.C.E. 2/ACE CD 2.iso/FILES/UTILS/AMOSPRO6.DMS/in.adf/Procedures/Plasma/_Plasma2.AMOS/_Plasma2.amosSourceCode

AMOS Source Code | 1992-09-29 | 9.4 KB | 198 lines

'*******************************************************
'*                                                     *
'* AMOS Professional Procedure Library                 *
'*                                                     *
'* Procedure: Plasma FX Routine                        *
'*                                                     *
'*    Author: Mike Stevens, Immortal Software          *
'*                                                     *
'*******************************************************

'The main procedure to this routine (_PLASMA_MAKE) creates a plasma effect
'field by a simple (and rather slow) recursive algorithm. It does this by
'chopping up the plasma field into cells, modifies the colour of each cell by
'a random amount, and then chops up each cell into a further number of cells,
'modifying each of those, and so on, until we reach the iteration level
'initially requested.

'  The _PLASMA routine is a front-end that does all the housework and
'generally makes using the _PLASMA_MAKE routine a lot easier.

'  The demo program for this simply calls the _PLASMA procedure with some
'defaults. The default value is a fairly low level of iteration (I didn't
'want to bore the user to death first time they ran the program). To get a
'better plasma inscrease the ITER parameter in the call to _PLASMA.

'  Although this procedure works so slowly, there are a couple of ways of
'getting around this- first, you can compile it (I haven't actually tried this
'yet); and second, you can generate the plasma on a screen, and then save
'it as an IFF screen, or an AMOS compressed picture bank.

'  One more point to note about this routine- to generate the plasma colours,
'I used the EdCols routine which is also on this disk. I generated a few
'palettes and saved them as IFF palettes on the disk as "PlasmaN_pal.IFF"
'where N is a number. When run, the program asks you to load one of these.
'It uses the _PALETTE_LOAD procedure from the EdCols routine to do this.

Randomize Timer
Screen Open 0,320,256,32,Lowres
Curs Off : Flash Off
Cls 0
_PNAME$=Fsel$("Plasma*.IFF","","Pick a palette to use...","")
If _PNAME$="" Then Direct
_PALETTE_LOAD[_PNAME$]
_PLASMA[0,0,256,256,6,1,31,5]
End
'
Procedure _PLASMA[TLX,TLY,WID,HGT,ITER,CLRMIN,CLRMAX,SPEED]
'
'   Inputs...
'         TLX, TLY - Top left co-ordinates of plasma field on screen.
'         WID, HGT - Width and height of the plasma field (pixels).
'         ITER - Number of iterations over which to calculate the plasma.
'         CLRMIN, CLRMAX - Range of colours to use for plasma.
'         SPEED - Rate at which to rotate colours. To rotate in opposite
'            direction to normal, make this number negative. Values closer
'            to 0 are faster. 0 itself will produce no rotation at all.
'
' ***********************************
'
' NB  This procedure is a front end for the _PLASMA_MAKE procedure, which
' can be quite daunting to use. What this procedure does is to automatically
' work out the optimum values to pass to _PLASMA_MAKE to get an effective
' plasma, and starts the colour cycling to animate the plasma automatically.
' It is currently set up for a default cell array size of 2*2, but you can
' play around with this to see how it affects the plasma. If you increase
' the array size, you will usually want to decrease the ITER value.
'
   _PLS_AWID=2 : _PLS_AHGT=2 : Rem ' Default cell array dimensions.
   _PLS_FWID=1 : _PLS_FHGT=1 : Rem ' Starting values to calculate the optimum field width.
   ' These two loops calculate the optimum field width to pass to the
   '_PLASMA_MAKE routine. This is based around the idea that the calculation
   'width/height should be a power of the cell array width/height. The actual
   'display width and height are then affected by the Clip command.
   Repeat
      _PLS_FWID=_PLS_FWID*_PLS_AWID
   Until _PLS_FWID>=WID
   Repeat
      _PLS_FHGT=_PLS_FHGT*_PLS_AHGT
   Until _PLS_FHGT>=HGT
   ' Work out the best RATE to get
   _PLS_RATE=(CLRMAX-CLRMIN)/ITER
   ' Set up the initial screen state.
   Cls 0,TLX,TLY To TLX+WID-1,TLY+HGT-1
   ' Restrict graphics to the requested screen area.
   Clip TLX,TLY To TLX+WID-1,TLY+HGT-1
   ' Now work out the actual plasma colours.
   _PLASMA_MAKE[TLX,TLY,_PLS_FWID,_PLS_FHGT,_PLS_AWID,_PLS_AHGT,ITER,CLRMIN,CLRMAX,_PLS_RATE]
   ' Finally, start them off cycling to get that truly psychedelic effect...
   ' *********   Hey man, like, which way's the moon ?!?  ;-)     ***********
   If SPEED>0 Then Shift Up SPEED,CLRMIN,CLRMAX,1 Else Shift Down SPEED,CLRMIN,CLRMAX,1
   ' Deactivate clipping before returning...
   Clip 0,0 To Screen Width,Screen Height
End Proc
'
Procedure _PLASMA_MAKE[TLX,TLY,FWID,FHGT,AWID,AHGT,ITER,CLRMIN,CLRMAX,RATE]
   '
   ' INPUTS :-  TLX,TLY - Co-ords of top left corner of plasma.
   '            FWID,FHGT - (FieldWIDth and FieldHeiGhT) Size of screen area
   '                  used by plasma. For best effects, these should be
   '                  calculated as powers of AWID and AHGT respectively.
   '            AWID,AHGT - (ArrayWID and ArrayHeiGhT) Dimensions of the array
   '                  used to split up a cell into more cells. 2 is the
   '                  minimum for each. NB the 'array' is not an actual
   '                  variable, but just a way representing the plasma field.
   '            ITER - The number of iterations over which to calulate the
   '                  plasma. Appropriate values for this will vary depending
   '                  upon AWID and AHGT, and there will be an effective
   '                  maximum for every resolution (although it is possible to
   '                  calculate beyond the maximum).
   '            CLRMIN - The lowest colour in the palette to be used for the
   '                  plasma field. It's best to start this at colour 1,
   '                  since cycling colour 0 (the background) does your eyes
   '                  in.
   '            CLRMAX - The highest colour in the palette to be used for the
   '                  plasma field.
   '            RATE - The maximum amount by which a colour can change (in
   '                  either direction) in any one one iteration.
   '
   ' *************************************************************
   '
   If ITER<1 Then Pop Proc : Rem ' Is this the last level of recursion ?
   CWID=Max(1,FWID/AWID) : Rem ' (CellWIDth) Width of each cell in pixels
   CHGT=Max(1,FHGT/AHGT) : Rem ' (CellHeiGhT) Height of each cell in pixels
   ' This loop splits the field up into an array of cells AHGT�AWID big.
   For Y=0 To AHGT-1
      For X=0 To AWID-1
         ' For each cell, we first get the current colour...
         _PLS_CELLCLR=Point(TLX+X*CWID,TLY+Y*CHGT)
         ' Then we modify it by a random number in the range -RATE to +RATE.
         Add _PLS_CELLCLR,Rnd(RATE*2)-RATE,CLRMIN To CLRMAX
         ' Now fill the cell in, in the new colour.
         Ink _PLS_CELLCLR
         ' This little If..Then..Else construct is necessitated by the fact
         'that AMOS' Bar command won't work if the bar size is only 1 pixel
         'in any direction, so we have to decide whether to use Bar or Draw.
         If CWID>1 and CHGT>1
            Bar TLX+X*CWID,TLY+Y*CHGT To TLX+X*CWID+CWID-1,TLY+Y*CHGT+CHGT-1
         Else
            Draw TLX+X*CWID,TLY+Y*CHGT To TLX+X*CWID+CWID-1,TLY+Y*CHGT+CHGT-1
         End If
         ' Finally, we recursively call ourself to further divide and fill
         'this cell.
         _PLASMA_MAKE[TLX+X*CWID,TLY+Y*CHGT,CWID,CHGT,AWID,AHGT,ITER-1,CLRMIN,CLRMAX,RATE]
      Next X
   Next Y
   ' And that's all there is to it! Simple, eh?
End Proc
'
'
'This procedure is from the EdCols palette editor unit.
'
Procedure _PALETTE_LOAD[NAME$]
'
'  Inputs...
'    NAME$ - The filename of the IFF-ILBM type colour palette file to load.
'
' **************************
'
'  User Functions...
'        Fn _RED - Returns the red component of a colour, given its RGB
'                 value.
'        Fn _GREEN - As _RED, but returns the green component.
'        FN _BLUE - As _RED and _GREEN, but returns the blue component.
'
' **************************
'
   Def Fn _RED(C)=(C and $F00)/$100
   Def Fn _GREEN(C)=(C and $F0)/$10
   Def Fn _BLUE(C)=C and $F
   ' Open the file in question.
   Open In 1,NAME$
   ' Check that it is an IFF type.
   _PLD_BUFFER$=Input$(1,4)
   If _PLD_BUFFER$<>"FORM" Then Close 1 : Error 30
   ' Cjeck that it is an ILBM type.
   _PLD_BUFFER$=Input$(1,4)
   _PLD_BUFFER$=Input$(1,4)
   If _PLD_BUFFER$<>"ILBM" Then Close 1 : Error 30
   ' Now we have to read each chunk until we find the "CMAP" chunk.
   _PLD_CHUNK$=Input$(1,4) : Rem  'First chunk's type
   _PLD_BUFFER$=Input$(1,4) : Rem 'First chunk's length
   While _PLD_CHUNK$<>"CMAP" and Not Eof(1) : Rem 'Go until we find the CMAP or we hit EOF.
      _PLD_CHUNKSIZE=Leek(Varptr(_PLD_BUFFER$)) : Rem 'Turn chunklength into a number variable.
      Pof(1)=Pof(1)+_PLD_CHUNKSIZE : Rem 'Read past this chunk.
      _PLD_CHUNK$=Input$(1,4) : Rem  'Read next chunk's type.
      _PLD_BUFFER$=Input$(1,4) : Rem 'Read next chunk's length.
   Wend
   If Eof(1) Then Close 1 : Error 30 : Rem ' If we didn't find the CMAP chunk, then quit.
   _PLD_CMAPSIZE=Leek(Varptr(_PLD_BUFFER$)) : Rem ' Read in whole palette.
   For _PLD_INDEX=0 To Min(_PLD_CMAPSIZE/3-1,31)
      _PLD_RED=Asc(Input$(1,1))*$10
      _PLD_GREEN=Asc(Input$(1,1))
      _PLD_BLUE=Asc(Input$(1,1))/$10
      Colour _PLD_INDEX,_PLD_RED+_PLD_GREEN+_PLD_BLUE
   Next _PLD_INDEX
   ' Close the file and end.
   Close 1
End Proc